home *** CD-ROM | disk | FTP | other *** search
Wrap
VERSION 2.00 Begin Form w_ctdate_demo BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "ctDATE (Monthly Calendar) Demo" ClientHeight = 5550 ClientLeft = 570 ClientTop = 1335 ClientWidth = 8805 Height = 5955 Icon = CT_DATE.FRX:0000 Left = 510 LinkTopic = "Form1" ScaleHeight = 5550 ScaleWidth = 8805 Top = 990 Width = 8925 Begin TextBox txt_date BackColor = &H00FFFFFF& FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 315 Left = 5820 TabIndex = 18 Top = 1380 Width = 2355 End Begin PictureBox ctPush1 BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 0 Top = 0 Width = 1000 End Begin PictureBox ctDate1 BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 3 Top = 0 Width = 1000 End Begin PictureBox ctGroup2 BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 4 Top = 0 Width = 1000 Begin PictureBox ctlw BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 8 Top = 0 Width = 1000 End Begin PictureBox ctraise BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 9 Top = 0 Width = 1000 End Begin PictureBox ctRadio2 BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 10 Top = 0 Width = 1000 End Begin PictureBox ctRadio1 BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 11 Top = 0 Width = 1000 End End Begin PictureBox ctGroup1 BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 12 Top = 0 Width = 1000 Begin PictureBox ctRadio4 BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 13 Top = 0 Width = 1000 End Begin PictureBox ctRadio3 BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 14 Top = 0 Width = 1000 End Begin PictureBox rb_none BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 15 Top = 0 Width = 1000 End Begin PictureBox rb_regular BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 16 Top = 0 Width = 1000 End End Begin CommandButton Command2 Caption = "Today" Height = 375 Left = 1440 TabIndex = 5 Top = 4980 Width = 945 End Begin PictureBox date_next BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 17 Top = 0 Width = 1000 End Begin PictureBox date_prev BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 21 Top = 0 Width = 1000 End Begin CommandButton Command1 Caption = "Exit" Height = 375 Left = 4320 TabIndex = 1 Top = 5040 Width = 795 End Begin PictureBox ctDate BackColor = &H000000FF& Height = 1000 Left = 0 ScaleHeight = 975 ScaleWidth = 975 TabIndex = 22 Top = 0 Width = 1000 End Begin Label lbl_move Alignment = 2 'Center BackColor = &H00C0C0C0& Caption = "Click on the arrows beside the title to move to a different month." FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00800000& Height = 675 Left = 6090 TabIndex = 20 Top = 4500 Visible = 0 'False Width = 2145 End Begin Label Label3 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "The example above uses a label control, picture push button, and a calendar control to simulate a drop down calendar box. Press the button to view the calendar" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00800000& Height = 2175 Left = 6060 TabIndex = 19 Top = 2100 Width = 2205 End Begin Label sle_date BackColor = &H00FFFFFF& BorderStyle = 1 'Fixed Single FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 315 Left = 1800 TabIndex = 7 Top = 1080 Width = 2475 End Begin Label Label2 BackColor = &H00C0C0C0& Caption = "Date Selected :" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 315 Left = 360 TabIndex = 6 Top = 1080 Width = 1455 End Begin Label Label1 Alignment = 2 'Center BackColor = &H00C0C0C0& Caption = "ctDATE VBX Is a Calendar Control that allows you to display and select dates in a visual format. The calendar works from 1900 on. Up to five different custom colors can be used to mark the dates. Differnt months or years can be viewed either through an Action attribute of the control, or by using internal controls." ForeColor = &H00800000& Height = 795 Left = 270 TabIndex = 2 Top = 120 Width = 8235 End Sub Command1_Click () Unload w_ctdate_demo End Sub Sub Command2_Click () ctDate.Action = 7 End Sub Sub ctDate_DateChange (nDow As Integer, nDay As Integer, nMonth As Integer, nYear As Integer) Dim MonthName As String If (nMonth = 1) Then ctDate.MarkDate(1) = 2 ElseIf (nMonth = 2) Then ctDate.MarkDate(14) = 4 ElseIf (nMonth = 4) Then ctDate.MarkDate(14) = 2 ElseIf (nMonth = 5) Then ctDate.MarkDate(22) = 2 ElseIf (nMonth = 7) Then ctDate.MarkDate(1) = 2 ctDate.MarkDate(4) = 2 ElseIf (nMonth = 9) Then ctDate.MarkDate(9) = 2 ElseIf (nMonth = 10) Then ctDate.MarkDate(4) = 2 ElseIf (nMonth = 11) Then ctDate.MarkDate(11) = 2 ElseIf (nMonth = 12) Then ctDate.MarkDate(24) = 3 ctDate.MarkDate(25) = 2 ctDate.MarkDate(26) = 3 End If If (nMonth = 1) Then MonthName = "Jan." ElseIf (nMonth = 2) Then MonthName = "Feb." ElseIf (nMonth = 3) Then MonthName = "Mar." ElseIf (nMonth = 4) Then MonthName = "Apr." ElseIf (nMonth = 5) Then MonthName = "May" ElseIf (nMonth = 6) Then MonthName = "June" ElseIf (nMonth = 7) Then MonthName = "July" ElseIf (nMonth = 8) Then MonthName = "Aug." ElseIf (nMonth = 9) Then MonthName = "Sep." ElseIf (nMonth = 10) Then MonthName = "Oct." ElseIf (nMonth = 11) Then MonthName = "Nov." ElseIf (nMonth = 12) Then MonthName = "Dec." MonthName = "???" End If MonthName = MonthName + " " + Str$(nDay) + " / " + Str$(nYear) If (nDow = 1) Then sle_date.Caption = "Sunday " + MonthName ElseIf (nDow = 2) Then sle_date.Caption = "Monday " + MonthName ElseIf (nDow = 3) Then sle_date.Caption = "Tuesday " + MonthName ElseIf (nDow = 4) Then sle_date.Caption = "Wednesday " + MonthName ElseIf (nDow = 5) Then sle_date.Caption = "Thursday " + MonthName ElseIf (nDow = 6) Then sle_date.Caption = "Friday " + MonthName ElseIf (nDow = 7) Then sle_date.Caption = "Saturday " + MonthName End If End Sub Sub ctDate1_DateChange (nDow As Integer, nDay As Integer, nMonth As Integer, nYear As Integer) Dim MonthName As String If (nMonth = 1) Then MonthName = "January" ElseIf (nMonth = 2) Then MonthName = "February" ElseIf (nMonth = 3) Then MonthName = "March" ElseIf (nMonth = 4) Then MonthName = "April" ElseIf (nMonth = 5) Then MonthName = "May" ElseIf (nMonth = 6) Then MonthName = "June" ElseIf (nMonth = 7) Then MonthName = "July" ElseIf (nMonth = 8) Then MonthName = "August" ElseIf (nMonth = 9) Then MonthName = "September" ElseIf (nMonth = 10) Then MonthName = "October" ElseIf (nMonth = 11) Then MonthName = "November" ElseIf (nMonth = 12) Then MonthName = "December" Else MonthName = "???" End If MonthName = MonthName + " " + Str$(nDay) + " / " + Str$(nYear) txt_date.Text = MonthName End Sub Sub ctDate1_LostFocus () lbl_move.Visible = False ctDate1.Visible = False End Sub Sub ctlw_Click () ctDate.FocusType = 3 End Sub Sub ctPush1_Click () lbl_move.Visible = True ctDate1.Visible = True ctDate1.SetFocus End Sub Sub ctRadio1_Click () ctDate.FocusType = 0 End Sub Sub ctRadio2_Click () ctDate.FocusType = 1 End Sub Sub ctRadio3_Click () ctDate.DateBorder = 2 End Sub Sub ctRadio4_Click () ctDate.DateBorder = 3 End Sub Sub ctraise_Click () ctDate.FocusType = 2 End Sub Sub date_next_ClickCenter () ctDate.Action = 2 End Sub Sub date_next_ClickLeft () ctDate.Action = 1 End Sub Sub date_next_ClickRight () ctDate.Action = 3 End Sub Sub date_prev_ClickCenter () ctDate.Action = 5 End Sub Sub date_prev_ClickLeft () ctDate.Action = 6 End Sub Sub date_prev_ClickRight () ctDate.Action = 4 End Sub Sub Form_Load () ' Center the window on the screen Move (Screen.Width - Width) / 2, (Screen.Height - Height) * .5 ctDate.Action = 7 ctDate1.Action = 7 End Sub Sub rb_none_Click () ctDate.DateBorder = 1 End Sub Sub rb_regular_Click () ctDate.DateBorder = 0 End Sub